(FILECREATED " 8-AUG-73 23:37:48" ACCT)
(LISPXPRINT (QUOTE ACCTVARS)
T)
(RPAQQ ACCTVARS
((FNS ADDTO DOACCT SETNAMES PRINTAMT SPLIT GETSPLIT DOACCT1
FIXNAME FIXAMT FIXFOR PRINFINAL FIXSPLIT)
[VARS (ACCTDATVARS (QUOTE ((VARS FORS ACCTS NAMES
STANDARDSPLIT)
(PROP SPLIT * FORS]
RUB DOWNARROW))
(DEFINEQ
(ADDTO
[LAMBDA (L N1 N2 V)
(* L is an alist of alists -- insert V under N2
under N1)
(PROG (P Q)
(OR (SETQ P (ASSOC N1 L NIL))
(SETQ L (CONS (SETQ P (LIST N1))
L)))
[OR (SETQ Q (ASSOC N2 (CDR P)))
(RPLACD P (CONS (SETQ Q (LIST N2))
(CDR P]
(NCONC1 Q V)
(RETURN L])
(DOACCT
[LAMBDA (INLIST)
(PROG (LIST1 TOTAL FINALIST)
[OR (LISTP (CAR (QUOTE NAMES)))
(PROGN (PRIN1 "NAMES? ")
(SETNAMES (READ T]
[OR (LISTP (CAR (QUOTE STANDARDSPLIT)))
(SETQ STANDARDSPLIT (MAPCAR NAMES (FUNCTION (LAMBDA (NAME)
(CONS NAME 1]
(DOACCT1 INLIST)
[MAPC
LIST1
(FUNCTION (LAMBDA (FORL) (* For each for type,
for each person, add up
the totals SPENT)
(MAPC (CDR FORL)
(FUNCTION (LAMBDA (NAMEL)
(TERPRI)
(PRIN1 (CAR NAMEL))
(PRIN1 (COND
((OR (MEMB (CAR FORL)
NAMES)
(GETP (CAR FORL)
(QUOTE NAME)))
" SPENT FOR ")
(T " PAID FOR ")))
(PRIN1 (OR (GETP (CAR FORL)
(QUOTE NAME))
(CAR FORL)))
(SETQ TOTAL 0)
[MAPC (CDR NAMEL)
(FUNCTION (LAMBDA (AD)
(PRIN1 "
")
[MAPC (CDR AD)
(FUNCTION (LAMBDA (X)
(PRIN1 X)
(SPACES 1]
(TAB 41)
(PRINTAMT (CAR AD))
(SETQ TOTAL (IPLUS TOTAL
(CAR AD]
(TAB 41)
(PRIN1 "--------")
(TAB 41)
(PRINTAMT TOTAL T)
(RPLACD NAMEL TOTAL]
(* Now the list looks
like (NAME . AMT))
(PRIN1 "↑L
")
[MAPC LIST1 (FUNCTION (LAMBDA (FORL)
(PRIN1 (CAR FORL))
(PRIN1 ":
")
(SETQ TOTAL 0)
[MAPC (CDR FORL)
(FUNCTION (LAMBDA (NAMEL)
(PRIN1 (CAR NAMEL))
(SETQ TOTAL (IPLUS TOTAL (CDR NAMEL)))
(TAB 20)
(PRINTAMT (CDR NAMEL)
T]
(PRIN1 " -------------
")
(TAB 20)
(PRINTAMT TOTAL T)
(RPLACD FORL (CONS (SPLIT (CAR FORL)
TOTAL)
(CDR FORL)))
(TERPRI]
(SETQ INLIST NIL)
[MAPC LIST1 (FUNCTION (LAMBDA (FORL)
[MAPC (CDDR FORL)
(FUNCTION (LAMBDA (NAMEL)
(SETQ INLIST (ADDTO INLIST (CAR NAMEL)
(CAR FORL)
(LIST (QUOTE SPENT)
(CDR NAMEL]
(MAPC (CADR FORL)
(FUNCTION (LAMBDA (NAMEL)
(SETQ INLIST (ADDTO INLIST (CAR NAMEL)
(CAR FORL)
(LIST (QUOTE OWE)
(CDR NAMEL]
[MAPC INLIST
(FUNCTION (LAMBDA (NAMEL)
(PROG ((OWE 0)
(SPENT 0))
(PRIN1 "↑L
")
(PRIN1 (CONCAT RUB DOWNARROW DOWNARROW
" The Alameda House" RUB
DOWNARROW (CHARACTER 3)
"
"))
(PRIN1 (CAR NAMEL))
(PRIN1 (CONCAT RUB DOWNARROW (CHARACTER
0)))
(PRIN1 ":
")
[MAPC (CDR NAMEL)
(FUNCTION (LAMBDA (FORL)
(SPACES 1)
(PRIN1 (CAR FORL))
[COND
((SETQ TEM (ASSOC (QUOTE SPENT)
(CDR FORL)))
(TAB 10)
(PRINTAMT (CADR TEM))
(SETQ SPENT
(IPLUS SPENT (CADR TEM]
[COND
((SETQ TEM (ASSOC (QUOTE OWE)
(CDR FORL)))
(TAB 30)
(PRINTAMT (CADR TEM))
(SETQ OWE (IPLUS OWE
(CADR TEM]
(TERPRI]
(TAB 10)
(PRIN1 "--------")
(TAB 30)
(PRIN1 "---------
")
(TAB 4)
(PRIN1 "SPENT")
(TAB 10)
(PRINTAMT SPENT)
(TAB 24)
(PRIN1 "OWE")
(TAB 30)
(PRINTAMT OWE)
(PRIN1 " NET:")
(PRINTAMT (IDIFFERENCE OWE SPENT)
T)
(SETQ FINALIST (CONS (LIST (CAR NAMEL)
(IDIFFERENCE
OWE SPENT))
FINALIST]
(PRIN1 "
")
(PRINFINAL FINALIST)
(RETURN FINALIST])
(SETNAMES
[LAMBDA (L)
(SETQ NAMES L])
(PRINTAMT
[LAMBDA (NUM TERPRIFLG)
(PROG (Y)
[SPACES (IDIFFERENCE 5 (NCHARS (SETQ Y (IQUOTIENT NUM 100]
(PRIN1 Y)
(PRIN1 ".")
(SETQ NUM (IREMAINDER NUM 100))
[COND
((MINUSP NUM)
(SETQ NUM (IMINUS NUM]
(COND
((ILESSP NUM 10)
(PRIN1 "0")))
(PRIN1 NUM)
(AND TERPRIFLG (TERPRI])
(SPLIT
[LAMBDA (TYPE TOTAL)
(PROG (SPLIT TOT)
(SETQ SPLIT
(OR [FIXSPLIT (OR [AND (MEMB TYPE NAMES)
(SETQ SPLIT (LIST (CONS TYPE 1]
(GETP TYPE (QUOTE SPLIT))
(PROGN (PRIN1 TYPE T)
(PRIN1 " SPLIT?" T)
(PUT TYPE (QUOTE SPLIT)
(READ T]
(HELP "INVALID SPLIT")))
(SETQ TOT 0)
[FOR N IN SPLIT DO (SETQ TOT (IPLUS TOT (CDR N]
(RETURN (FOR N IN SPLIT
COLLECT (CONS (CAR N)
(IQUOTIENT
(IPLUS (ITIMES TOTAL (CDR N))
(IQUOTIENT TOT 2))
TOT])
(GETSPLIT
[LAMBDA (FOR)
(GETP FOR (QUOTE SPLIT])
(DOACCT1
[LAMBDA (INLIST)
(PROG (NAME FOR AMT COMMENTS)
LP [COND
[INLIST
(COND
([AND [SETQ NAME (FIXNAME (CAR (CAR INLIST]
[SETQ FOR (FIXFOR (CADR (CAR INLIST]
(SETQ AMT (FIXAMT (CADDR (CAR INLIST]
(SETQ COMMENTS (CDDDR (CAR INLIST)))
[RPLACA INLIST (CONS NAME (CONS
FOR (CONS (FQUOTIENT
AMT 100)
COMMENTS]
(SETQ INLIST (CDR INLIST)))
(T (PRIN1 "EDIT
" T)
[SETQ INLIST
(CAR (LAST (EDITL (LIST (CAR INLIST)
INLIST)
NIL NIL (CAR INLIST]
(GO LP]
(T (NLSETQ (PROG NIL
NAMLP
(PRIN1 "WHO? " T)
(COND
((NOT (SETQ NAME (READ T)))
(RETURN NIL)))
(OR (FIXNAME NAME)
(GO NAMLP))
FORLP
(PRIN1 "FOR? " T)
(SETQ FOR (OR (FIXFOR (READ T))
(GO FORLP)))
AMTLP
(PRIN1 "AMT? " T)
(OR (SETQ AMT (FIXAMT (READ T)))
(GO AMTLP))
(CLBUFS)
(PRIN1 "REMARKS? " T)
COMMENTLP
(COND
((FMEMB (PEEKC T)
(QUOTE % %
))
(READC T)
(GO COMMENTLP)))
(SETQ COMMENTS (READLINE]
(COND
((NOT NAME)
(RETURN LIST1)))
(SETQ LIST1 (ADDTO LIST1 FOR NAME (CONS AMT COMMENTS)))
(GO LP])
(FIXNAME
[LAMBDA (NAME)
(OR (MISSPELLED? NAME 70 NAMES)
(MISSPELLED? (PACK (LIST NAME "≠"))
70 NAMES)
(AND (EQ (PROGN (PRIN1 NAME)
(PRIN1 " NEW PERSON? " T)
(READ T))
(QUOTE Y))
(CAR (SETQ NAMES (CONS NAME NAMES])
(FIXAMT
[LAMBDA (N)
(AND [SETQ N (NUMBERP (CAR (NLSETQ (EVAL N]
(ITIMES (TIMES N 100])
(FIXFOR
[LAMBDA (FOR)
(OR (MISSPELLED? FOR 70 FORS (FUNCTION GETSPLIT))
(FIXNAME FOR)
(AND [PUT FOR (QUOTE SPLIT) (PROG (SPLIT)
(PRIN1 FOR)
(PRIN1 " SPLIT? " T)
(SETQ SPLIT (READ T))
(COND
((EQ SPLIT (QUOTE -))
(RETURN STANDARDSPLIT)))
(RETURN (FIXSPLIT SPLIT]
(CAR (SETQ FORS (CONS FOR FORS])
(PRINFINAL
[LAMBDA (FL)
(MAPC FL (FUNCTION (LAMBDA (X)
(PRIN1 (CAR X))
(TAB 30)
(PRINTAMT (CADR X))
(TERPRI])
(FIXSPLIT
[LAMBDA (SPLIT)
(AND (LISTP SPLIT)
[EVERY SPLIT (FUNCTION (LAMBDA (X)
(AND (CAR (RPLACA X (MISSPELLED? (CAR X)
70 NAMES)))
(NUMBERP (CDR X]
SPLIT])
)
(RPAQQ ACCTDATVARS ((VARS FORS ACCTS NAMES STANDARDSPLIT)
(PROP SPLIT * FORS)))
(RPAQQ RUB ␈)
(RPAQQ DOWNARROW ↓)
STOP